unit KRK.Components.Win32Controls.PageControl;

interface

uses Controls, ImgList, Messages, Types, ComCtrls, Classes, System.UITypes;

type
  TKRKPageControl = class;

  TKRKTabSheet = class(TWinControl)
  private
    FImageIndex: TImageIndex;
    FPageControl: TKRKPageControl;
    FTabVisible: Boolean;
    FTabShowing: Boolean;
    FHighlighted: Boolean;
    FOnHide: TNotifyEvent;
    FOnShow: TNotifyEvent;
    function GetPageIndex: Integer;
    function GetTabIndex: Integer;
    procedure SetHighlighted(Value: Boolean);
    procedure SetImageIndex(Value: TImageIndex);
    procedure SetPageControl(APageControl: TKRKPageControl);
    procedure SetPageIndex(Value: Integer);
    procedure SetTabShowing(Value: Boolean);
    procedure SetTabVisible(Value: Boolean);
    procedure UpdateTabShowing;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DoHide; dynamic;
    procedure DoShow; dynamic;
    procedure ReadState(Reader: TReader); override;
    procedure UpdateControlOriginalParentSize(AControl: TControl; var AOriginalParentSize: TPoint); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property PageControl: TKRKPageControl read FPageControl write SetPageControl;
    property TabIndex: Integer read GetTabIndex;
  published
    property Action;
    property BorderWidth;
    property Caption;
    property DoubleBuffered;
    property DragMode;
    property Enabled;
    property Font;
    property Height stored False;
    property Highlighted: Boolean read FHighlighted write SetHighlighted default False;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default 0;
    property Left stored False;
    property Constraints;
    property PageIndex: Integer read GetPageIndex write SetPageIndex stored False;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabVisible: Boolean read FTabVisible write SetTabVisible default True;
    property Top stored False;
    property Touch;
    property Visible stored False;
    property Width stored False;
    property OnContextPopup;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
    property OnStartDrag;
  end;

  TKRKPageControl = class(TCustomTabControl)
  private
    FPages: TList;
    FActivePage: TKRKTabSheet;
    FNewDockSheet: TKRKTabSheet;
    FUndockingPage: TKRKTabSheet;
    FInSetActivePage: Boolean;
    procedure ChangeActivePage(Page: TKRKTabSheet);
    procedure DeleteTab(Page: TKRKTabSheet; Index: Integer);
    function GetActivePageIndex: Integer;
    function GetDockClientFromMousePos(MousePos: TPoint): TControl;
    function GetPage(Index: Integer): TKRKTabSheet;
    function GetPageCount: Integer;
    procedure InsertPage(Page: TKRKTabSheet);
    procedure InsertTab(Page: TKRKTabSheet);
    procedure MoveTab(CurIndex, NewIndex: Integer);
    function PageIndexFromTabIndex(TabIndex: Integer): Integer;
    procedure RemovePage(Page: TKRKTabSheet);
    procedure SetActivePageIndex(const Value: Integer);
    procedure UpdateTab(Page: TKRKTabSheet);
    procedure UpdateTabHighlights;
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMDockNotification(var Message: TCMDockNotification); message CM_DOCKNOTIFICATION;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
{$IF NOT DEFINED(CLR)}
    procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
    procedure CMUnDockClient(var Message: TCMUnDockClient); message CM_UNDOCKCLIENT;
{$ENDIF}
  protected
    function CanShowTab(TabIndex: Integer): Boolean; override;
    procedure Change; override;
    procedure DoAddDockClient(Client: TControl; const ARect: TRect); override;
    procedure DockOver(Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); override;
    procedure DoRemoveDockClient(Client: TControl); override;
    function GetImageIndex(TabIndex: Integer): Integer; override;
    function GetPageFromDockClient(Client: TControl): TKRKTabSheet;
    procedure GetSiteInfo(Client: TControl; var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean); override;
    procedure Loaded; override;
    procedure SetActivePage(Page: TKRKTabSheet);
    procedure SetChildOrder(Child: TComponent; Order: Integer); override;
    procedure SetTabIndex(Value: Integer); override;
    procedure ShowControl(AControl: TControl); override;
    procedure UpdateActivePage; virtual;
{$IF DEFINED(CLR)}
    function DockClient(DockSource: TDragDockObject; MousePos: TPoint): Integer; override;
    function UndockClient(NewTarget, Client: TControl): Boolean; override;
{$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function FindNextPage(CurPage: TKRKTabSheet; GoForward, CheckTabVisible: Boolean): TKRKTabSheet;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean = True);
    property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex;
    property PageCount: Integer read GetPageCount;
    property Pages[Index: Integer]: TKRKTabSheet read GetPage;
  published
    property ActivePage: TKRKTabSheet read FActivePage write SetActivePage;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HotTrack;
    property Images;
    property MultiLine;
    property OwnerDraw;
    property ParentBiDiMode;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property ScrollOpposite;
    property ShowHint;
    property Style;
    property TabHeight;
    property TabIndex stored False;
    property TabOrder;
    property TabPosition;
    property TabStop;
    property TabWidth;
    property Touch;
    property Visible;
    property OnChange;
    property OnChanging;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetImageIndex;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

implementation

uses Themes, Windows, ComStrs, Forms, CommCtrl, Consts, SysUtils, ActnList;

constructor TKRKTabSheet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Align := alClient;
  ControlStyle := ControlStyle + [csAcceptsControls, csNoDesignVisible, csParentBackground, csPannable];
  Visible := False;
  FTabVisible := True;
  FHighlighted := False;
end;

destructor TKRKTabSheet.Destroy;
begin
  if FPageControl <> nil then
  begin
    if FPageControl.FUndockingPage = Self then
      FPageControl.FUndockingPage := nil;
    FPageControl.RemovePage(Self);
  end;
  inherited Destroy;
end;

procedure TKRKTabSheet.DoHide;
begin
  if Assigned(FOnHide) then
    FOnHide(Self);
end;

procedure TKRKTabSheet.DoShow;
begin
  if Assigned(FOnShow) then
    FOnShow(Self);
end;

function TKRKTabSheet.GetPageIndex: Integer;
begin
  if FPageControl <> nil then
    Result := FPageControl.FPages.IndexOf(Self)
  else
    Result := -1;
end;

function TKRKTabSheet.GetTabIndex: Integer;
var
  I: Integer;
begin
  Result := 0;
  if not FTabShowing then
    Dec(Result)
  else
    for I := 0 to PageIndex - 1 do
      if TKRKTabSheet(FPageControl.FPages[I]).FTabShowing then
        Inc(Result);
end;

procedure TKRKTabSheet.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if not StyleServices.Available then
    with Params.WindowClass do
      style := style and not (CS_HREDRAW or CS_VREDRAW);
end;

procedure TKRKTabSheet.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TKRKPageControl then
    PageControl := TKRKPageControl(Reader.Parent);
end;

procedure TKRKTabSheet.SetImageIndex(Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    if FTabShowing then
      FPageControl.UpdateTab(Self);
  end;
end;

procedure TKRKTabSheet.SetPageControl(APageControl: TKRKPageControl);
begin
  if FPageControl <> APageControl then
  begin
    if FPageControl <> nil then
      FPageControl.RemovePage(Self);
    Parent := APageControl;
    if APageControl <> nil then
      APageControl.InsertPage(Self);
  end;
end;

procedure TKRKTabSheet.SetPageIndex(Value: Integer);
var
  I, MaxPageIndex: Integer;
begin
  if FPageControl <> nil then
  begin
    MaxPageIndex := FPageControl.FPages.Count - 1;
    if Value > MaxPageIndex then
      raise EListError.CreateResFmt({$IFNDEF CLR}@{$ENDIF}SPageIndexError, [Value, MaxPageIndex]);
    I := TabIndex;
    FPageControl.FPages.Move(PageIndex, Value);
    if I >= 0 then
      FPageControl.MoveTab(I, TabIndex);
  end;
end;

procedure TKRKTabSheet.SetTabShowing(Value: Boolean);
var
  Index: Integer;
begin
  if FTabShowing <> Value then
    if Value then
    begin
      FTabShowing := True;
      FPageControl.InsertTab(Self);
    end else
    begin
      Index := TabIndex;
      FTabShowing := False;
      FPageControl.DeleteTab(Self, Index);
    end;
end;

procedure TKRKTabSheet.SetTabVisible(Value: Boolean);
begin
  if FTabVisible <> Value then
  begin
    FTabVisible := Value;
    UpdateTabShowing;
  end;
end;

procedure TKRKTabSheet.UpdateControlOriginalParentSize(AControl: TControl;
  var AOriginalParentSize: TPoint);
begin
  inherited;
  if not (csReading in ComponentState) and not HandleAllocated then
    Dec(AOriginalParentSize.X, BorderWidth * 2);
end;

procedure TKRKTabSheet.UpdateTabShowing;
begin
  SetTabShowing((FPageControl <> nil) and FTabVisible);
end;

procedure TKRKTabSheet.CMTextChanged(var Message: TMessage);
begin
  if FTabShowing then
    FPageControl.UpdateTab(Self);
end;

procedure TKRKTabSheet.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if Showing then
  begin
    try
      DoShow
    except
      Application.HandleException(Self);
    end;
  end
  else
  if not Showing then
  begin
    try
      DoHide;
    except
      Application.HandleException(Self);
    end;
  end;
end;

procedure TKRKTabSheet.SetHighlighted(Value: Boolean);
begin
  if not (csReading in ComponentState) then
    if Assigned(PageControl) then
      SendMessage(PageControl.Handle, TCM_HIGHLIGHTITEM, TabIndex,
        MakeLong(Word(Value), 0))
    else
      raise EInvalidOperation.Create(SPageControlNotSet);
  FHighlighted := Value;
end;

procedure TKRKTabSheet.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  DrawRect: TRect;
  Details: TThemedElementDetails;
begin
  with StyleServices do
  begin
    if Enabled and (BorderWidth > 0) then
    begin
      DC := GetWindowDC(Handle);
      try
        DrawRect := ClientRect;
        OffsetRect(DrawRect, BorderWidth, BorderWidth);
        with DrawRect do
          ExcludeClipRect(DC, Left, Top, Right, Bottom);
        SetWindowOrgEx(DC, -BorderWidth, -BorderWidth, nil);
        Details := GetElementDetails(ttBody);
        DrawParentBackground(Handle, DC, Details, False);
      finally
        ReleaseDC(Handle, DC);
      end;
      Message.Result := 0;
    end
    else
      inherited;
  end;
end;

procedure TKRKTabSheet.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
  R: TRect;
  BorderSize: Integer;
  Details: TThemedElementDetails;
begin
  if (PageControl <> nil) and (PageControl.Style = tsTabs) and StyleServices.Enabled then
  begin
    GetWindowRect(Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    BorderSize := ClientToParent(Point(0, 0)).X;
    InflateRect(R, BorderSize, BorderSize); // ttPane also contains the border that we don't want
    Details := StyleServices.GetElementDetails(ttPane);
    StyleServices.DrawElement(Message.DC, Details, R);
    Message.Result := 1;
  end
  else
    inherited;
end;

{ TKRKPageControl }

constructor TKRKPageControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csDoubleClicks, csOpaque, csPannable, csGestures];
  FPages := TList.Create;
end;

destructor TKRKPageControl.Destroy;
var
  I: Integer;
begin
  for I := 0 to FPages.Count - 1 do TKRKTabSheet(FPages[I]).FPageControl := nil;
  FPages.Free;
  inherited Destroy;
end;

procedure TKRKPageControl.UpdateTabHighlights;
var
  I: Integer;
begin
  for I := 0 to PageCount - 1 do
    Pages[I].SetHighlighted(Pages[I].FHighlighted);
end;

procedure TKRKPageControl.Loaded;
begin
  inherited Loaded;
  UpdateTabHighlights;
end;

function TKRKPageControl.CanShowTab(TabIndex: Integer): Boolean;
begin
  Result := TKRKTabSheet(FPages[PageIndexFromTabIndex(TabIndex)]).Enabled;
end;

procedure TKRKPageControl.Change;
var
  Form: TCustomForm;
begin
  if TabIndex >= 0 then
    UpdateActivePage;
  if csDesigning in ComponentState then
  begin
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.Designer <> nil) then
      Form.Designer.Modified;
  end;
  inherited Change;
end;

procedure TKRKPageControl.ChangeActivePage(Page: TKRKTabSheet);
var
  ParentForm: TCustomForm;
begin
  if FActivePage <> Page then
  begin
    ParentForm := GetParentForm(Self);
    if (ParentForm <> nil) and (FActivePage <> nil) and
      FActivePage.ContainsControl(ParentForm.ActiveControl) then
    begin
      ParentForm.ActiveControl := FActivePage;
      if ParentForm.ActiveControl <> FActivePage then
      begin
        TabIndex := FActivePage.TabIndex;
        Exit;
      end;
    end;
    if Page <> nil then
    begin
      Page.BringToFront;
      Page.Visible := True;
      if (ParentForm <> nil) and (FActivePage <> nil) and
        (ParentForm.ActiveControl = FActivePage) then
        if Page.CanFocus then
          ParentForm.ActiveControl := Page else
          ParentForm.ActiveControl := Self;
    end;
    if FActivePage <> nil then FActivePage.Visible := False;
    FActivePage := Page;
    if (ParentForm <> nil) and (FActivePage <> nil) and
      (ParentForm.ActiveControl = FActivePage) then
      FActivePage.SelectFirst;
  end;
end;

procedure TKRKPageControl.DeleteTab(Page: TKRKTabSheet; Index: Integer);
var
  UpdateIndex: Boolean;
begin
  UpdateIndex := Page = ActivePage;
  Tabs.Delete(Index);
  if UpdateIndex then
  begin
    if Index >= Tabs.Count then
      Index := Tabs.Count - 1;
    TabIndex := Index;
  end;
  UpdateActivePage;
end;

procedure TKRKPageControl.DoAddDockClient(Client: TControl; const ARect: TRect);
begin
  if FNewDockSheet <> nil then
    Client.Parent := FNewDockSheet;
end;

procedure TKRKPageControl.DockOver(Source: TDragDockObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  R: TRect;
begin
  GetWindowRect(Handle, R);
  Source.DockRect := R;
  DoDockOver(Source, X, Y, State, Accept);
end;

procedure TKRKPageControl.DoRemoveDockClient(Client: TControl);
begin
  if (FUndockingPage <> nil) and not (csDestroying in ComponentState) then
  begin
    SelectNextPage(True);
    FUndockingPage.Free;
    FUndockingPage := nil;
  end;
end;

function TKRKPageControl.FindNextPage(CurPage: TKRKTabSheet;
  GoForward, CheckTabVisible: Boolean): TKRKTabSheet;
var
  I, StartIndex: Integer;
begin
  if FPages.Count <> 0 then
  begin
    StartIndex := FPages.IndexOf(CurPage);
    if StartIndex = -1 then
      if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
    I := StartIndex;
    repeat
      if GoForward then
      begin
        Inc(I);
        if I = FPages.Count then I := 0;
      end else
      begin
        if I = 0 then I := FPages.Count;
        Dec(I);
      end;
      Result := TKRKTabSheet(FPages[I]);
      if not CheckTabVisible or Result.TabVisible then Exit;
    until I = StartIndex;
  end;
  Result := nil;
end;

procedure TKRKPageControl.GetChildren(Proc: TGetChildProc; Root: TComponent);
var
  I: Integer;
begin
  for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I]));
end;

function TKRKPageControl.GetImageIndex(TabIndex: Integer): Integer;
var
  I,
  Visible,
  NotVisible: Integer;
begin
  if Assigned(OnGetImageIndex) then
    Result := inherited GetImageIndex(TabIndex) else
    begin
     { For a PageControl, TabIndex refers to visible tabs only. The control
     doesn't store }
      Visible := 0;
      NotVisible := 0;
      for I := 0 to FPages.Count - 1 do
      begin
        if not GetPage(I).TabVisible then Inc(NotVisible)
        else Inc(Visible);
        if Visible = TabIndex + 1 then Break;
      end;
      Result := GetPage(TabIndex + NotVisible).ImageIndex;
    end;
end;

function TKRKPageControl.GetPageFromDockClient(Client: TControl): TKRKTabSheet;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to PageCount - 1 do
  begin
    if (Client.Parent = Pages[I]) and (Client.HostDockSite = Self) then
    begin
      Result := Pages[I];
      Exit;
    end;
  end;
end;

function TKRKPageControl.GetPage(Index: Integer): TKRKTabSheet;
begin
  Result := TKRKTabSheet(FPages[Index]);
end;

function TKRKPageControl.GetPageCount: Integer;
begin
  Result := FPages.Count;
end;

procedure TKRKPageControl.GetSiteInfo(Client: TControl; var InfluenceRect: TRect;
  MousePos: TPoint; var CanDock: Boolean);
begin
  CanDock := GetPageFromDockClient(Client) = nil;
  inherited GetSiteInfo(Client, InfluenceRect, MousePos, CanDock);
end;

procedure TKRKPageControl.InsertPage(Page: TKRKTabSheet);
begin
  FPages.Add(Page);
  Page.FPageControl := Self;
  Page.UpdateTabShowing;
end;

procedure TKRKPageControl.InsertTab(Page: TKRKTabSheet);
begin
  Tabs.InsertObject(Page.TabIndex, Page.Caption, Page);
  UpdateActivePage;
end;

procedure TKRKPageControl.MoveTab(CurIndex, NewIndex: Integer);
begin
  Tabs.Move(CurIndex, NewIndex);
end;

procedure TKRKPageControl.RemovePage(Page: TKRKTabSheet);
var
  NextSheet: TKRKTabSheet;
begin
  NextSheet := FindNextPage(Page, True, not (csDesigning in ComponentState));
  if NextSheet = Page then NextSheet := nil;
  Page.SetTabShowing(False);
  Page.FPageControl := nil;
  FPages.Remove(Page);
  SetActivePage(NextSheet);
end;

procedure TKRKPageControl.SelectNextPage(GoForward: Boolean; CheckTabVisible: Boolean = True);
var
  Page: TKRKTabSheet;
begin
  Page := FindNextPage(ActivePage, GoForward, CheckTabVisible);
  if (Page <> nil) and (Page <> ActivePage) and CanChange then
  begin
    SetActivePage(Page);
    Change;
  end;
end;

procedure TKRKPageControl.SetActivePage(Page: TKRKTabSheet);
begin
  if (Page <> nil) and (Page.PageControl <> Self) then
    Exit;
  FInSetActivePage := True;
  try
    ChangeActivePage(Page);
    if Page = nil then
      TabIndex := -1
    else
      if Page = FActivePage then
        TabIndex := Page.TabIndex;
  finally
    FInSetActivePage := False;
  end;
end;

procedure TKRKPageControl.SetChildOrder(Child: TComponent; Order: Integer);
begin
  TKRKTabSheet(Child).PageIndex := Order;
end;

procedure TKRKPageControl.ShowControl(AControl: TControl);
begin
  if (AControl is TKRKTabSheet) and (TKRKTabSheet(AControl).PageControl = Self) then
    SetActivePage(TKRKTabSheet(AControl));
  inherited ShowControl(AControl);
end;

procedure TKRKPageControl.UpdateTab(Page: TKRKTabSheet);
begin
  Tabs[Page.TabIndex] := Page.Caption;
end;

procedure TKRKPageControl.UpdateActivePage;
begin
  if TabIndex >= 0 then
    SetActivePage(TKRKTabSheet(Tabs.Objects[TabIndex]))
  else
    SetActivePage(nil);
end;

procedure TKRKPageControl.CMDesignHitTest(var Message: TCMDesignHitTest);
var
  HitIndex: Integer;
  HitTestInfo: TTCHitTestInfo;
begin
  HitTestInfo.pt := SmallPointToPoint(Message.Pos);
  HitIndex := SendStructMessage(Handle, TCM_HITTEST, 0, HitTestInfo);
  if (HitIndex >= 0) and (HitIndex <> TabIndex) then
    Message.Result := 1;
end;

procedure TKRKPageControl.CMDialogKey(var Message: TCMDialogKey);
begin
  if (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
    (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0) then
  begin
    SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
    Message.Result := 1;
  end else
    inherited;
end;

{$IF DEFINED(CLR)}
function TKRKPageControl.DockClient(DockSource: TDragDockObject; MousePos: TPoint): Integer;
{$ELSE}
procedure TKRKPageControl.CMDockClient(var Message: TCMDockClient);
{$ENDIF}
var
  IsVisible: Boolean;
  DockCtl: TControl;
  I: Integer;
begin
{$IF NOT DEFINED(CLR)}
  with Message do
{$ENDIF}
  begin
    Result := 0;
    DockCtl := DockSource.Control;
    { First, look and see if the page is already docked. If it is,
      then simply move the page index to the end }
    for I := 0 to PageCount - 1 do
    begin
      if DockCtl.Parent = Pages[I] then
      begin
        { We did find it; just move the page to the end }
        Pages[I].PageIndex := PageCount - 1;
        Exit;
      end;
    end;

    FNewDockSheet := TKRKTabSheet.Create(Self);
    try
      try
        if DockCtl is TCustomForm then
          FNewDockSheet.Caption := TCustomForm(DockCtl).Caption;
        FNewDockSheet.PageControl := Self;
        DockCtl.Dock(Self, DockSource.DockRect);
      except
        FNewDockSheet.Free;
        raise;
      end;
      IsVisible := DockCtl.Visible;
      FNewDockSheet.TabVisible := IsVisible;
      if IsVisible then
        ActivePage := FNewDockSheet;
      DockCtl.Align := alClient;
    finally
      FNewDockSheet := nil;
    end;
  end;
end;

procedure TKRKPageControl.CMDockNotification(var Message: TCMDockNotification);
var
  I: Integer;
  S: string;
  Page: TKRKTabSheet;
begin
  Page := GetPageFromDockClient(Message.Client);
  if Page <> nil then
    case Message.NotifyRec.ClientMsg of
      WM_SETTEXT:
        begin
{$IF DEFINED(CLR)}
          S := Marshal.PtrToStringAuto(IntPtr(Message.NotifyRec.MsgLParam));
{$ELSE}
          S := PChar(Message.NotifyRec.MsgLParam);
{$ENDIF}
          { Search for first CR/LF and end string there }
          for I := 1 to Length(S) do
            if CharInSet(S[I], [#13, #10]) then
            begin
              SetLength(S, I - 1);
              Break;
            end;
          Page.Caption := S;
        end;
      CM_VISIBLECHANGED:
        Page.TabVisible := Boolean(Message.NotifyRec.MsgWParam);
    end;
  inherited;
end;

{$IF DEFINED(CLR)}
function TKRKPageControl.UndockClient(NewTarget, Client: TControl): Boolean;
{$ELSE}
procedure TKRKPageControl.CMUnDockClient(var Message: TCMUnDockClient);
{$ENDIF}
var
  Page: TKRKTabSheet;
begin
{$IF NOT DEFINED(CLR)}
  with Message do
  begin
    Result := 0;
{$ELSE}
  begin
    Result := True;
{$IFEND}
    Page := GetPageFromDockClient(Client);
    if Page <> nil then
    begin
      FUndockingPage := Page;
      Client.Align := alNone;
    end;
  end;
end;

function TKRKPageControl.GetDockClientFromMousePos(MousePos: TPoint): TControl;
var
  i, HitIndex: Integer;
  HitTestInfo: TTCHitTestInfo;
  Page: TKRKTabSheet;
begin
  Result := nil;
  if DockSite then
  begin
    HitTestInfo.pt := MousePos;
    HitIndex := SendStructMessage(Handle, TCM_HITTEST, 0, HitTestInfo);
    if HitIndex >= 0 then
    begin
      Page := nil;
      for i := 0 to HitIndex do
        Page := FindNextPage(Page, True, True);
      if (Page <> nil) and (Page.ControlCount > 0) then
      begin
        Result := Page.Controls[0];
        if Result.HostDockSite <> Self then Result := nil;
      end;
    end;
  end;
end;

procedure TKRKPageControl.WMLButtonDown(var Message: TWMLButtonDown);
var
  DockCtl: TControl;
begin
  inherited;
  DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos));
  if (DockCtl <> nil) and (Style = tsTabs) then
    DockCtl.BeginDrag(False);
end;

procedure TKRKPageControl.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var
  DockCtl: TControl;
begin
  inherited;
  DockCtl := GetDockClientFromMousePos(SmallPointToPoint(Message.Pos));
  if DockCtl <> nil then
    DockCtl.ManualDock(nil, nil, alNone);
end;

function TKRKPageControl.GetActivePageIndex: Integer;
begin
  if ActivePage <> nil then
    Result := ActivePage.GetPageIndex
  else
    Result := -1;
end;

procedure TKRKPageControl.SetActivePageIndex(const Value: Integer);
begin
  if (Value > -1) and (Value < PageCount) then
    ActivePage := Pages[Value]
  else
    ActivePage := nil;
end;

procedure TKRKPageControl.SetTabIndex(Value: Integer);
begin
  inherited;
  if not FInSetActivePage and (Value >= 0) and (Value < FPages.Count) and
    Pages[Value].TabVisible then
  begin
    SetActivePage(Pages[PageIndexFromTabIndex(Value)]);
  end;
end;

procedure TKRKPageControl.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  if (not StyleServices.Enabled) or (not ParentBackground) then
    inherited
  else
    Message.Result := 1;
end;

function TKRKPageControl.PageIndexFromTabIndex(TabIndex: Integer): Integer;
var
  I: Integer;
begin
  // Tabs doesn't contain hidden TabSheets so the index
  // needs to be adjusted to account for any hidden pages.
  Result := TabIndex;
  for I := 0 to TabIndex do
    if not Pages[I].TabVisible then
      Inc(Result);
end;

end.
